home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #102 (1990-12)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #102 (1990-12)(Amiga User Group Deutschland e.V.).adf / Raumgestaltung / Raumgestaltung (.txt) < prev    next >
AmigaBASIC Source Code  |  1989-07-03  |  7KB  |  240 lines
  1.  
  2. SCREEN 2,320,250,5,1
  3. WINDOW 2,"           RAUMGESTALTUNG",,0,2
  4.   PALETTE 29,0,0,0      
  5.   PALETTE 1,0.8,0,0     
  6.   PALETTE 2,1,0,0      
  7.   PALETTE 3,0.93,0.2,0   
  8.   PALETTE 4,1,0.4,0     
  9.   PALETTE 5,1,0.6,0     
  10.   PALETTE 6,1,0.8,0     
  11.   PALETTE 7,1,1,0     
  12.   PALETTE 8,0.6,1,0.15   
  13.   PALETTE 9,0.5,0.8,0.15  
  14.   PALETTE 10,0.4,0.6,0   
  15.   PALETTE 11,0.2,0.4,0   
  16.   PALETTE 12,0,0.4,0    
  17.   PALETTE 13,0,0.6,0.67  
  18.   PALETTE 14,0,0.8,0.6   
  19.   PALETTE 15,0,1,0.6   
  20.   PALETTE 16,0.2,1,0.93  
  21.   PALETTE 17,0.2,0.75,1  
  22.   PALETTE 18,0.15,0.4,1  
  23.   PALETTE 19,0.4,0,1    
  24.   PALETTE 20,0,0,0.6    
  25.   PALETTE 21,0.35,0.15,0.8
  26.   PALETTE 22,0.6,0.2,1   
  27.   PALETTE 23,1,0,1     
  28.   PALETTE 24,0.9,0.5,0.75 
  29.   PALETTE 25,1,0.75,0.75 
  30.   PALETTE 26,0.8,0.55,0.5 
  31.   PALETTE 27,0.6,0.4,0.35 
  32.   PALETTE 28,0.4,0.2,0   
  33.   PALETTE 0,0.1,0.1,0.1  
  34.   PALETTE 30,0.6,0.6,0.6   
  35.   PALETTE 31,1,1,1    
  36.    CLEAR ,20000                
  37.    DIM bau(110,20)  
  38.    w=1:mx=-1:my=0
  39.    FOR ein=1 TO 20
  40. ON ein GOSUB radier,fenstero,fensteru,fensterl,fensterr,kreuz,vierb,tisch,stuhlk,kasten,balkeno,balkenu,links,rechts,stuhl,eckelu,eckero,eckeol,eckeur,tischgr
  41.    GET(0,0)-(19,19),bau(110,ein-1)
  42.    CLS               
  43.    NEXT
  44.    GOSUB Rahmen : GOSUB bauen   
  45. retur:
  46.    MENU ON
  47.    WHILE MOUSE(0) = 0
  48.    x = MOUSE(1): y = MOUSE(2)
  49.    IF y<180 THEN
  50.    PUT(x-10,y-5),bau(110,w)
  51.    PUT(x-10,y-5),bau(110,w)
  52.    END IF
  53.    WEND       
  54.    IF x> = 300 THEN retur                
  55.    IF y> = 180 THEN GOTO taste
  56. kleber:                             
  57.    x = FIX (x/20): y = FIX(y/20)
  58.    x = x*20: y = y*20
  59.    IF w = 19 AND mx<>-1 THEN PUT(mx,my),bau(110,19)
  60.    IF x = mx AND y = my THEN mx = -1
  61.    IF w<19 THEN PUT(x,y),bau(110,w),PSET :ELSE PUT(x,y),bau(110,19)
  62.    mx = x: my = y
  63.    GOTO retur 
  64. taste:                           
  65.    rx = MOUSE(1)
  66.    rx = FIX(rx/20): y = FIX(y/20): y = y*20
  67.    IF y = 180 THEN w = rx
  68.    IF y = 200 AND rx<5 THEN w = 15+rx 
  69.    IF y = 200 AND rx> = 5 THEN druecke
  70.    a = MOUSE(0) 
  71.    GOTO retur
  72. '**************************
  73. druecke:
  74.     rx = MOUSE(1)
  75.     IF rx <160 AND rx >120 THEN sauber
  76.     IF rx <220 AND rx >180 THEN GOTO ende    
  77. sauber:
  78.     LINE (20,20)-(280,178),0,bf
  79.     GOTO retur
  80. bauen:
  81.   FOR a = 0 TO 14 
  82.   x = a*20
  83.   PUT (x,182), bau(110,a),PSET
  84.   NEXT
  85.   FOR a = 15 TO 19
  86.   x =  a*20-300
  87.   PUT (x,202), bau(110,a),PSET
  88.   NEXT
  89.       CIRCLE (140,220),20,11,,,0.5:PAINT(140,220),11:CIRCLE (140,220),21,19,,,0.5:
  90.       CALL tool (125,220):COLOR 3,11:LOCATE 28,17:PRINT "NEU"
  91.       CIRCLE (204,220),22,11,,,0.5 :PAINT(200,220),11:CIRCLE (204,220),23,19,,,0.5 :
  92.       CALL tool (185,220):COLOR 3,11:LOCATE 28,25:PRINT "END"
  93.   RETURN 
  94. Rahmen:
  95.    l=1:h=1
  96.    COLOR 17,0
  97.    LOCATE 3,5:PRINT "Geben Sie bitte ein."
  98.    LOCATE 6,5:PRINT "Raummindestmasse 10 * 8 m"
  99.    LOCATE 9,12:  INPUT"Länge   ";l            ' Länge
  100.    LOCATE 12,12:  INPUT"Breite  ";h           ' Breite
  101.    CLS
  102.    IF l< 11 THEN a = 282
  103.    IF h<  9 THEN b = 180
  104.    LINE(18,18)-(a,b),17,b             
  105.    LINE(19,19)-(a-1,b-1),17,b   
  106.    e=18 :f=18
  107.    FOR x = 18 TO a STEP (a-18)/l         
  108.    LINE (x,e-5) - (x,e+1),4
  109.    NEXT x   
  110.    FOR y = 18 TO b STEP (b-18)/h         
  111.    LINE (f-5,y) - (f+1,y),4
  112.    NEXT y
  113.    COLOR 12,0:LOCATE 2,35:PRINT l :LOCATE 2,39:PRINT"m"
  114.    COLOR 12,0:LOCATE 22,1:PRINT h:LOCATE 23,1:PRINT"m"
  115.    LINE(18,18)-(a,b),17,b 
  116.    LINE(19,19)-(a-1,b-1),17,b 
  117.    SUB tool(c%,d%) STATIC
  118.    xa&=WINDOW(8)+36:ya&=WINDOW(8)+38
  119.    POKEW xa&,c%
  120.    POKEW ya&,d%
  121.    END SUB
  122.  
  123. radier:
  124.    LINE (0,0)-(20,20),0,bf
  125.    RETURN
  126.  
  127. fenstero:
  128.    LINE (0,10)-(19,19),7,b
  129.    LINE (0,10)-(19,19),7
  130.    LINE (0,19)-(19,10),7
  131.    RETURN
  132.  
  133. fensteru:
  134.    LINE (0,0)-(19,10),7,b
  135.    LINE (0,0)-(19,10),7
  136.    LINE (0,10)-(19,0),7
  137.    RETURN
  138. fensterl:
  139.    LINE (0,0)-(10,19),7,b
  140.    LINE (0,0)-(10,19),7
  141.    LINE (10,0)-(0,19),7
  142.    RETURN
  143.  
  144. kreuz:
  145.    LINE (0,0)-(19,19),7,b
  146.    LINE (0,0)-(19,19),7
  147.    LINE (0,19)-(19,0),7
  148.    RETURN
  149.  
  150. stuhl:
  151.   CIRCLE (10,10),6,9,,,1
  152.   PAINT (10,10),9 
  153.   RETURN
  154.  
  155. vierb:
  156.   LINE (0,0)-(19,3),19,bf
  157.   LINE (0,0)-(3,19),19,bf
  158.   LINE (16,0)-(19,16),19,bf
  159.   LINE (0,16)-(19,19),19,bf
  160.   RETURN
  161.  
  162. tisch:
  163.   LINE (0,0)-(19,19),26,bf
  164.   RETURN
  165.  
  166. fensterr:
  167.   LINE (10,0)-(19,19),7,b
  168.   LINE (10,0)-(19,19),7
  169.   LINE (10,19)-(19,0),7
  170.   RETURN
  171.  
  172. rechts:
  173.   LINE (10,0)-(19,19),28,bf
  174.   RETURN
  175.  
  176. links:
  177.   LINE (0,0)-(10,19),28,bf
  178.   RETURN
  179.  
  180. balkenu:
  181.   LINE (0,10)-(19,19),28,bf
  182.   RETURN
  183.  
  184. balkeno:
  185.   LINE (0,0)-(19,10),28,bf
  186.   RETURN
  187.  
  188. kasten:
  189.   LINE (10,1)-(1,10),25
  190.   LINE -(10,19),25
  191.   LINE -(19,10),25
  192.   LINE -(10,1),25
  193.   PAINT (10,14),25
  194.   RETURN
  195.  
  196. eckelu:
  197.    LINE (0,0)-(10,19),7,b
  198.    LINE (10,10)-(19,19),7,b
  199.    LINE (10,11)-(10,18),0
  200.    RETURN
  201.  
  202. eckero:
  203. LINE (0,0)-(19,10),7,b
  204. LINE (10,10)-(19,19),7,b
  205. LINE (11,10)-(18,10),0
  206. RETURN
  207.  
  208. eckeur:
  209. LINE (0,10)-(19,19),7,b
  210. LINE (10,0)-(19,10),7,b
  211. LINE (11,10)-(18,10),0
  212. RETURN
  213.  
  214. eckeol:
  215. LINE (0,0)-(19,10),7,b
  216. LINE (0,0)-(10,19),7,b
  217. LINE (10,1)-(10,9),0
  218. LINE (1,10)-(9,10),0
  219. RETURN
  220.  
  221. stuhlk:
  222. LINE (5,5)-(15,15),3,bf
  223. RETURN
  224.  
  225. tischgr:
  226. CIRCLE (10,10),8,0,,,1:PAINT(10,10),0
  227. RETURN
  228.  
  229. ende:
  230. WINDOW CLOSE 2:SCREEN CLOSE 2
  231. SYSTEM   
  232. END
  233.  '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  234.  '
  235.  'Detlef Kornatz
  236.  'Feuerbachstrasse 6
  237.  'D-4300 ESSEN 1
  238.  '
  239.  '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  240.